COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	SUBR(MORCOR)------------------------------------------------------
C00004 00003	SUBR(MAKE)TYPE,,RELOC---------------------------------------------
C00006 00004	SUBR(SHRINK)------------------------------------------------------
C00008 00005	REPLACE LINKS ABOVE THE BREAK WITH THEIR NEW VALUES.
C00011 ENDMK
C⊗;
;SUBR(MORCOR)------------------------------------------------------
INTERN OLD44,FILM,BLKCNT,AVAIL
	OLD44:	0
	FILM:	0
	BLKCNT: 0
	AVAIL:	0
	REMAINDER:0
	NODSIZ←←7
SUBR(MORCOR)------------------------------------------------------
BEGIN MORCOR; - GET MORE CORE - BGB - 4 DEC 1972.

;INITIALIZE FILM BLOCK POINTERS WHEN NECESSARY.
	SKIPE OLD44↔GO L1
	MOVE 1,44↔MOVEM 1,OLD44
	AOS 1↔MOVEM 1,FILM
	ADDI 1,3↔MOVEM 1,AVAIL
	AOS 1↔MOVEM 1,BLKCNT
	SETZM REMAINDER

;FOUR MORE K !
L1:	MOVE 1,44↔MOVE 0,1↔ADDI 0,10000
	HRRE 0,0↔JUMPL 0,[FATAL(127K MAX FOR TVFONT, YOU LOSE)]
	CALLI 11↔GO[FATAL(NO MORE CORE.)]
	AOS 1↔SUB 1,REMAINDER↔MOVEM 2,AC2#↔MOVE 2,44
	SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)

;MAKE AVAIL LIST.
	HRLM 1,1↔ADD 1,[XWD NODSIZ,0]
	SKIPE@BLKCNT↔GO .+3
	ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@BLKCNT
	DAPZ 1,@AVAIL
L2:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
	CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
	SUBI 2,NODSIZ-1(1)↔MOVEM 2,REMAINDER
	MOVEI 10000↔ADDM @FILM
	MOVE 1,FILM↔MOVE[FILBIT+010000]↔MOVEM 2(1)
	MOVE 1,@AVAIL
	MOVE 2,AC2↔POP0J
BEND;12/16/72-----------------------------------------------------
SUBR(MAKE)TYPE,,RELOC---------------------------------------------
BEGIN MAKE; ALLOCATE A NODSIZ BLOCK OF WORDS - BGB - 4 DEC 1972.
	SKIPN 1,@AVAIL
	CALL(MORCOR)
	HRRZ(1)↔HRRM @AVAIL
	SETZM(1)↔AOS @BLKCNT
	POP P,.+3↔POP P,2(1)↔GO @.+1↔0
	POP1J
BEND;1/10/73------------------------------------------------------

SUBR(KILL)NODE----------------------------------------------------
BEGIN KILL; - RELEASE A NODSIZ BLOCK OF WORDS - BGB - 4 DEC 1972.
	MOVE 1,ARG1
	SKIPN 2(1)↔GO[OUTSTR[ASCIZ/	EMPTY NODE KILLED.
/]↔POP1J]↔SOS @BLKCNT
	SETZM(1)↔HRLI(1)↔HRRI 1(1)↔BLT NODSIZ-1(1)
	MOVE @AVAIL↔HRRZM(1)↔HRRZM 1,@AVAIL
	POP1J
BEND;12/17/72-----------------------------------------------------

SUBR(RINGIN)------------------------------------------------------
BEGIN RINGIN;(PART,WHOLE) RING PART INTO A WHOLE -BGB- 6 DEC 1972.
	MOVE 1,ARG2
	MOVE 3,ARG1
	SON 2,3
	JUMPE 2,[SON. 1,3↔CW. 1,(1)↔CCW. 1,(1)↔POP2J]
	CW 3,(2)
	CW. 3,(1)↔CCW. 1,(3)
	CCW. 2,(1)↔CW. 1,(2)
	POP2J↔LIT
BEND;1/10/73------------------------------------------------------
SUBR(SHRINK)------------------------------------------------------
BEGIN SHRINK;SHRINK NODE SPACE - BGB - 17 JANUARY 1973.
	ACCUMULATORS{A,HOLE,BREAK,NODE}
	EXTERNAL ZIPDPY
	CALL(ZIPDPY)			;FLUSH DISPLAY BUFFER POINTERS
	MOVE@BLKCNT↔IMULI NODSIZ↔ADD FILM
	MOVEM BREAK↔MOVEI NODE,-NODSIZ(BREAK)↔SKIPA HOLE,FILM

;FIND A HOLE BELOW THE BREAK.
L1:	ADDI HOLE,NODSIZ↔CAML HOLE,BREAK↔GO L3
	TYPE 0,HOLE↔JUMPN 0,L1

;FIND A NODE ABOVE THE BREAK.
L2:	ADDI NODE,NODSIZ
	CAML NODE,44↔GO[FATAL({SHRINK - NODE CNT TOO BIG.})]
	TYPE 0,NODE↔JUMPE 0,L2

;MOVE THE NODE INTO THE HOLE.
	HRLM NODE,0↔HRRM HOLE,0
	BLT 0,NODSIZ-1(HOLE)
	DAPZ HOLE,0(NODE)	;NODE'S NEW LOCATION.
	GO L1
;REPLACE LINKS ABOVE THE BREAK WITH THEIR NEW VALUES.
	DEFINE KAR(Q){
		HLRZ 1,Q(A)
		CAML 1,BREAK↔MOVE 1,0(1)
		HRLM 1,Q(A)↔GO .+1}
	DEFINE KDR(Q){
		HRRZ 1,Q(A)
		CAML 1,BREAK↔MOVE 1,0(1)
		HRRM 1,Q(A)↔GO .+1}

L3:	MOVE A,FILM	;BLOCK POINTER.
L4:	RELOC 0,A↔TRNE 400000↔MOVEI 333333
	TRNE 200000↔GO[KAR 0]↔ TRNE 100000↔GO[KDR 0]
	TRNE 20000 ↔GO[KAR 1]↔ TRNE 10000 ↔GO[KDR 1]
	TRNE 2000  ↔GO[KAR 3]↔ TRNE 1000  ↔GO[KDR 3]
	TRNE 200   ↔GO[KAR 4]↔ TRNE 100   ↔GO[KDR 4]
	TRNE 20    ↔GO[KAR 5]↔ TRNE 10    ↔GO[KDR 5]
	TRNE 2     ↔GO[KAR 6]↔ TRNE 1     ↔GO[KDR 6]
	ADDI A,NODSIZ↔CAMGE A,BREAK↔GO L4

;SHRINK CORE SIZE AND RESET AVAIL LIST.
	MOVE 0,BREAK↔IORI 0,1777↔CALLI 0,11↔HALT	   ;SHRINK CORE.
	MOVE 1,BREAK↔MOVE 2,44↔DAPZ 1,@AVAIL	   ;NEW BOUNDS.
	MOVEI 0,1(1)↔HRLM 1,0↔SETZM(1)↔BLT(2)	   ;CLEAR AVAILS.
	MOVEI 1(2)↔SUB FILM↔MOVEM@FILM		   ;NEW CORE SIZE.

	LIPI 1,NODSIZ(1)↔GO L6
L5:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
L6:	CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
	SUBI 2,NODSIZ-1(1)↔MOVEM 2,REMAINDER↔POP0J

	LIT
BEND;1/17/73------------------------------------------------------